00100	C  SUBRS. VLINE, ASKIT, GRED, LPEN, SAVIT, LISTP ***************
00200	 
00300	 
00400		SUBROUTINE VLINE(R3,R4,R5,R6)
00500		INTEGER ASK
00600		COMMON /MKX/KSLA,ISEMI,LESS,IGT/A2Z/LAA,LBB,NONO(9),LEL
00700		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /IDEV/IDEV
00800		IF(R5.NE.0)GO TO 66
00900	267	IF(IDEV.EQ.5)
01000		1 CALL TYPSTR('TYPE STAFF #, POS1, POS2 AND CODE #  ')
01100	CRR** NEXT WITH NEW RREAD IN MS.F4   CAN NOW TYPE M 1 0 200 16, ETC.
01200		READ(IDEV,F78F,END=167)R3,R4,R5,R6
01300	CQQ	ACCEPT F78F,R3,R4,R5,R6
01400		REREAD FA1,ASK
01500		IF(ASK.EQ.LESS)GO TO 167
01600		CALL LO2UP(ASK)
01700		IF(ASK.NE.IGT)GO TO 2
01800		IDEV=1
01900		GO TO 267
02000	2	IF(ASK.EQ.LBB)R3=99
02100	C  99 IS ALSO USED IN MOVER.F4
02200		IF(R3.GE.99)RETURN
02300		IF(ASK.NE.LEL)GO TO 66
02400	C  TYPE 'L' FOR LIGHT-PEN
02500		K=-1
02600	67	 R4=RY
02700		CALL LPEN(R3,RY,RX)
02800		REREAD FA1,ASK
02900		CALL LO2UP(ASK)
03000		IF(ASK.EQ.LBB)R3=99
03100		IF(R3.GE.99)RETURN
03200		K=-K
03300		IF(K.GT.0)GO TO 67
03400		R5=RY
03500	C LIGHT PEN IS READ TWICE
03600	66	 ASK=-1
03700		IF(R6.LT.100)GO TO 1
03800		R6=R6-100
03900	C  FOR 'ASK' ADD 100 TO PARAM NUMBER GIVEN.
04000		ASK=0
04100	1	CALL BOX(-1,R4)
04200		CALL BOX(-2,R5)
04300	C  PUTS UP TWO VERTICAL LINES
04400		RETURN
04500	CCC3	FORMAT(' TYPE STAFF #, POS1, POS2 AND CODE #  '$)
04600	167	IDEV=5
04700		GO TO 267
04800		END
04900	 
05000	 
05100		SUBROUTINE ASKIT
05200		INTEGER ASK
05300		COMMON /DPY/ST(4000),MEDIT,IGO/A2Z/NONO(6),LGG
05400		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
05500		COMMON /XRN/RN(1) /KJY/ K,JY
05600		IGO=0
05700		CALL DPYNEW
05800		X=ST(2)
05900		CALL BOX(JY,RN(JY+2))
06000		ST(2)=X
06100		CALL TYPSTR('N=NO, <CR>=YES, G=GO  ')
06200		ACCEPT FA1,K
06300		IF(K.EQ.LGG)ASK=-1
06400		CALL DPYNEW
06500		IGO=1
06600		END
06700	 
06800		SUBROUTINE GRED
06900		INTEGER PWDS
07000		COMMON /MKX/KSLA,ISEMI,LESS,IGT
07100		1/A2Z/LAA,LBB,LCC,LDD,NONO(7),LEL,LMM,LNN,NON(9),LXX
07200		COMMON /DPY/IST(4000),MEDIT,IGO /IDEV/IDEV
07300		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /KJY/ K,JY
07400		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
07500		COMMON R2,JA,J,J2,RJQ(6),RC,IZ,RX,KV,RY,IA,IB,C,D,JZ,A,
07600		1 NX,VY,RB,JQ(20) /XRN/RN(1) /ALF/INP(72),ML
07700		COMMON /PTR/PWDS(1) /POSI/STFF(8),JJB,POS
07800		1 /LIMIT/LIMIT,ITEM,L,I,IX
07900		1 /RINP/R(10,80),RPOS(100) /DPTR/IWDS(1)
08000	 
08100		EQUIVALENCE (IST2,IST(2)),(I2,INP(2))
08200		RC=999
08300		RSTF=RC
08400	CC **CAN'T GET HERE ***IF(INP(1).NE.'A'.AND.INP(1).NE.'D')GO TO 1
08500	C  LEAVES ROUTINE
08600		POS=0
08700	C ABOVE FOR NEW RREAD IN MS.
08800	7	CALL VLINE(R2,Z,POS,RX)
08900	C  PUTS UP TWO VERTICAL LINES
09000		REREAD FA1,NX
09100		CALL LO2UP(NX)
09200		IF(NX.EQ.LBB)GO TO 170
09300		IF(R2.LT.99)GO TO 70
09400	170	JA=98
09500		RETURN
09600	70	 IF(POS.EQ.0)POS=200
09700	C  0,0  DOES WHOLE STAFF
09800		IF(INP(1).NE.LAA)GO TO 4
09900	267	IF(IDEV.EQ.1)GO TO 467
10000		CALL TYPSTR(' TYPE P#, CHNG,  P#, CHNG,  P#, CHNG, ...')
10100		CALL TYPCRL
10200	467	READ(IDEV,F78F,END=167)V
10300	CQQ	ACCEPT F78F,V
10400		REREAD FA1,K
10500	C  TYPE 'L' FOR LIGHT PEN
10600		IF(K.EQ.LESS)GO TO 167
10700		CALL LO2UP(K)
10800		IF(K.NE.IGT)GO TO 367
10900		IDEV=1
11000		GO TO 267
11100	367	IF(V(1).EQ.99)GO TO 7
11200		IF(K.EQ.LBB)GO TO 7
11300	C TYPE 'B' OR 99 TO BACKUP
11400		IF(K.NE.LEL)GO TO 66
11500		DO 67 K=1,2
11600		V(2)=RY
11700		CALL LPEN(V(1),RY,RX)
11800		REREAD FA1,JA
11900		CALL LO2UP(JA)
12000		IF(JA.EQ.LBB)GO TO 7
12100	67	 IF(V(1).GE.99)GO TO 7
12200		V(3)=RY
12300	66	 JA=0
12400		IZ=0
12500	C  COUNTER
12600		GO TO 14
12700	167	IDEV=5
12800		GO TO 267
12900	4	JA=98
13000	C  DEL=FOR DELETIONS   CD=CENTER DASHES BETWEEN SYLLABLES.
13100		IF(I2.EQ.LDD)JA=0
13200	C  STF.N, -99	-- DELETES ALL BUT STAFF N.
13300		IF(Z.NE.-99)GO TO 14
13400		RSTF=R2
13500		R2=99
13600	14	 NX=0
13700	C  LOOP STARTS HERE
13800		J=0
13900	140	NX=NX+1
14000	142	JY=PWDS(NX)
14100		RB=RN(JY+3)
14200		IF(RTLINE(JY))GO TO 6
14300		IF(RB.LT.Z)GO TO 6
14400		IF(RB.GT.POS)GO TO 6
14500		IF(RN(JY+2).EQ.RSTF)GO TO 6
14600	C  FOR -99 DELETES.
14700		RB=RN(JY+1)
14800	 
14900		IF(I2.NE.LDD)GO TO 71
15000	C NEXT FOR 'CD'  CENTER DASHES WITH TEXT
15100		IF(RB.NE.4.)GO TO 6
15200		IF(RN(JY).LT.8.)GO TO 6
15300	C P10 MUST BE .GT.0
15400		CALL DASHES(ITEM,RN(JY+2),RN(JY+3))
15500		GO TO 6
15600	 
15700	71	 IF(V(1).EQ.12)GO TO 77
15800		IF(V(1).EQ.100)GO TO 341
15900	C USE P100 AND ANY CODE# TO CREATE CUES. I.E. MINI NOTES, RESTS, BEAMS.
16000		IF(RC.EQ.999)GO TO 143
16100	C  USE P12 TO INVERT STEM, BEAM AND SLURS ALL AT ONCE.
16200	C  SET 12 TO 1 WITH CODE 5 TO INVERT SLURS ONLY
16300	77	 RC=0
16400		IF(RB.EQ.5)GO TO 141
16500		IF(RB.NE.6)GO TO 143
16600		IF(RX.EQ.1)GO TO 141
16700	143	IF(RX.NE.44.)GO TO 144
16800	C USE CODE 44 FOR ALL 'LINE' EXCEPT BARLINES.
16900		IF(RB.NE.4)GO TO 6
17000		IF(RN(JY).LE.2)GO TO 6
17100		GO TO 100
17200	144	IF(RB.NE.RX.AND.RX.NE.0)GO TO 6
17300	CXX	IF(ASK)GO TO 100
17400	CXX	CALL ASKIT
17500	CXX	IF(K.EQ.LNN)GO TO 6
17600	CXX	IF(K.EQ.LXX)GO TO 19
17700	100	IF(INP(1).EQ.LAA)GO TO 141
17800		IF(J)GO TO 40
17900		J=-1
18000		K=NX
18100	41	 IZ=NX
18200		IF(NX.LT.ITEM)GO TO 140
18300	40	 IF(NX-IZ.EQ.1)GO TO 41
18400	C  GO BACK FOR MORE - IF IN RIGHT ORDER.
18500	C  RANGE TO DEL. = K↑YNX
18600	45	 J=IZ+1
18700		IA=PWDS(K)
18800		IB=PWDS(J)-IA
18900		JZ=IWDS(K)
19000		J2=IWDS(J)-JZ
19100		J=J-K
19200		ITEM=ITEM-J
19300		DO 42 IZ=K,ITEM+1
19400		PWDS(IZ)=PWDS(IZ+J)-IB
19500	42	 IWDS(IZ)=IWDS(IZ+J)-J2
19600		IST2=IST2-J2
19700		I=I-IB
19800		 CALL LOOP(IA,I,1,0,IB,RN)
19900		CALL LOOP(JZ+2,IST2+2,1,0,J2,IST)
20000		IF(K.GE.ITEM)GO TO 1
20100	C  EXITS
20200		NX=K+1
20300		GO TO 142
20400	341	IF(RB.EQ.6)GO TO 141
20500		IF(RB.GT.2)GO TO 6
20600	141	IF(IZ.GE.97)GO TO 9
20700	C   THERE'S A LIMIT TO THE R ARRAY	4/18/73
20800		IZ=IZ+1
20900	C  FOUND AN ITEM
21000		R(1,IZ)=223
21100	C 223 IS CODE NUMB. FOR EDIT MODE
21200		R(2,IZ)=NX
21300	10	 IZ=IZ+1
21400		DO 101 KV=3,10
21500	101	R(KV,IZ)=0
21600		IF(V(1).NE.100)GO TO 131
21700	231	R(1,IZ)=400
21800	C  MAKES MINI NOTES, RESTS, BEAMS
21900		R(2,IZ)=100
22000		GO TO 6
22100	131	IF(RC.EQ.999)GO TO 11
22200		IF(RB.EQ.1)GO TO 30
22300	31	 RC=RN(JY+7)
22400		IF(RB.EQ.6)GO TO 32
22500	C  NEXT INVERTS DIP
22600		IF(RX.EQ.1)GO TO 35
22700		A=-1.6
22800		RB=-10
22900		IF(RC)A=-A
23000	CC***????  WHY CHANGE P2???  ****36	R(7,IZ)=2
23100	CC***   R(8,IZ)=RN(JY+2)+A
23200		GO TO 37
23300	35	 RB=-4
23400		IF(RN(JY+8).LT.-1)RB=-1.4
23500	C  2 AND .7 ARE HGTS SET IN 'BEAMS'
23600	37	 IF(RC)RB=-RB
23700		R(3,IZ)=4
23800		R(4,IZ)=RN(JY+4)+RB
23900		R(6,IZ)=RN(JY+5)+RB
24000		R(5,IZ)=5
24100	33	 R(1,IZ)=7
24200		R(2,IZ)=-RC
24300		GO TO 6
24400	32	 IF(RC.LT.20)GO TO 34
24500	C  THIS IS FOR BEAMS
24600	232	RC=10-RC
24700		GO TO 33
24800	132	IF(RC.GT.-20)GO TO 232
24900		GO TO 332
25000	34	 IF(RC)GO TO 132
25100	C  P7 IS NEG FOR TREMOLOS
25200	332	RC=-10-RC
25300		GO TO 33
25400	 
25500	C  NEXT INVERTS STEMS EITHER WAY. USE ANY #>11 WITH CODE 1 TO INVERT.
25600	C  MUST! BE FIRST IN LIST!!!
25700	C	RC=0
25800	30	 RB=RN(JY+5)
25900		IF(RB.LT.10)GO TO 12
26000	C  NO STEM < 10
26100		RC=10
26200		IF(RB.GE.20)RC=-RC
26300		RB=RB+RC
26400	12	 V(1)=5.
26500		V(2)=RB
26600	C  SO IT WILL DISPLAY RESULT
26700	11	 DO 8 K=1,10
26800	8	R(K,IZ)=V(K)
26900	6	IF(J)GO TO 45
27000		IF(NX.LT.ITEM)GO TO 140
27100	19	 IF(INP(1).NE.LAA)GO TO 1
27200	9	R(1,IZ+1)=222
27300		R(1,IZ+2)=0
27400	CC	 REND=-1.
27500	1	CALL HYDPOG(3)
27600		END
27700	 
27800		SUBROUTINE LPEN(A,B,C)
27900		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
28000		COMMON /POSI/STFF(0/7),JJ2,POS /ALF/INP(71),M,L /C/MM,LL
28100		COMMON /A2Z/LAA,LBB,NONO(21),LXX
28200	C**** CCRMA ******
28300		RETURN
28400	C**** CCRMA ******
28500		M=MM
28600		L=LL
28700		IF(IABS(M).GT.512)GO TO 4
28800	CC	 IF(IABS(L).LE.512)GO TO 3
28900	4	M=0
29000		L=100
29100	CC3	CALL SETCUR(M,L,0)
29200		CALL TYPSTR('TYPE <CR> TO SET POINT')
29300		ACCEPT FA1,JD
29400		IF(JD.EQ.'9')RETURN
29500		IF(JD.EQ.LXX)RETURN
29600	C  TYPE 'B' OR 99 TO BACK UP
29700		IF(JD.EQ.LBB)RETURN
29800	CC	 CALL RDCUR(M,L)
29900		L=(L+KCEN)/RSZ
30000	1	B=((M+JCEN)/RSZ+596.0)/5.96
30100	C  B=HORIZ. STEP NUM.
30200		DO 13 K=0,7
30300		M=STFF(K)+60.
30400		IF(L.GT.M)GO TO 13
30500		A=K
30600	C  A=STAFF NUM.
30700		GO TO 8
30800	13	 CONTINUE
30900	8	C=IFIX((L-STFF(K)+21.)/7.+.5)
31000	C  FINDS VERT. NOTE NUM.
31100		TYPE F78F,A,B
31200		END
31300	 
31400	 
31500		SUBROUTINE SAVIT
31600		IMPLICIT INTEGER(A-Q,S-Z)
31700		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK/DL/X22,SAVER,NAME,EXT
31800		1 /POSI/STFF(0/7),JJ2,IPOS /LIMIT/LIMIT,ITEM,L,I,IX
31900		1 /SCM/V(78),ISCR,LCNT,IRSTF,LIST(200),REND  /IDEV/IDEV
32000		1 /ALF/INP(72),ML/XRN/RN(1)/DPY/ST(4000),MEDIT,IGO
32100		1 /STF/RSTFAC(0/7),RSTJ2 /PTR/PWDS(1) /JCHAR/IXX,ISEMI,IBLA
32200		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
32300		COMMON /A2Z/LAA,LBB,LCC,LDD,NONO(8),LMM,LNN,NON(4),LSS
32400		DIMENSION SV(128)
32500		EQUIVALENCE (INP2,INP(2)),(ST2,ST(2)),(SV,LIST)
32600	C  'SAME' WILL REPEAT CURRENT NAME.  BLANK WILL USE TMP.MS
32700		KX=-1
32800		K=0
32900	32	 K=K+1
33000	C  THIS IS TO REPAIR DAMAGE DONE BY UNKNOWN BUGS!!!!
33100	33	 L=PWDS(K)
33200		IA=PWDS(K+1)
33300		IB=RN(L)+3.+L
33400	C  THIS SHOULD BE NEW POINTER
33500		IF(IA-IB.EQ.0)GO TO 36
33600		IF(RN(IB)+3+IB.NE.PWDS(K+2))GO TO 38
33700		J=K+1
33800		PWDS(J)=IB
33900		CALL TYPSTR('?FIXED UP ITEM ')
34000		CALL TYPINT(J)
34100		CALL TYPCRL
34200		GO TO 36
34300	38	 IJ=IA-L
34400		DO 39 J2=K+1,ITEM
34500	39	 PWDS(J2)=PWDS(J2+1)-IJ
34600		CALL TYPSTR('BAD ITEM--')
34700		CALL TYPINT(K)
34800		CALL TYPCRL
34900		IF(KX.EQ.0)GO TO 50
35000		CALL TYPSTR('NAME.EXT? ')
35100		ACCEPT 141,INP
35200		CALL NAMEXT(INP,NAME,EXT)
35300	C  ONLY DOES THIS ON THE FIRST ERROR
35400		GO TO 2
35500	50	 J=RJ
35600		KX=0
35700		CALL LOOP(L,I,1,0,J,RN)
35800	C  REARRANGES DATA
35900		I=I-J
36000		ITEM=ITEM-1
36100		IF(ITEM.LE.K)GO TO 37
36200		GO TO 33
36300	C  GO BACK AND TRY AGAIN
36400	36	 IF(IA.LE.L)GO TO 38
36500	C  JUMP IF PWDS IS OUT OF ORDER
36600		IF(K.LT.ITEM)GO TO 32
36700	37	 KX=-1
36800		IF(SAVER.GE.0)GO TO 10
36900		SAVER=5
37000	101	CALL PUTEXT('TMP','MS ')
37100		GO TO 102
37200	1	FORMAT(I,24F)
37300	2	CALL TYPCHR('WRITE OVER   ',13)
37400		CALL TYPWRD(NAME)
37500		CALL TYPCHR('.',1)
37600		CALL TYPCHR(EXT,3)
37700		CALL TYPCHR('?  ',3)
37800		ACCEPT 141,INP
37900		CALL LULOOP
38000		IF(INP(1).NE.LNN)GO TO 4
38100	10	 IF(INP2.EQ.LMM)GO TO 4
38200	11	 L=NAME
38300		INP(1)=-1
38400		CALL NAMEXT(INP,NAME,EXT)
38500		IF(NAME.NE.IBLA)GO TO 40
38600		CALL TYPSTR('NAME.EXT? ')
38700		ACCEPT 141,INP
38800		CALL NAMEXT(INP,NAME,EXT)
38900		IF(NAME.EQ.IBLA)GO TO 4
39000	C 99 WILL BACK UP.
39100		IF(NAME.NE.'99')GO TO 40
39200		NAME=L
39300		RETURN
39400	40	 IF(NAME.NE.'SAME')GO TO 43
39500		NAME=L
39600		GO TO 4
39700	141	FORMAT(72A1)
39800	43	 IF(LOOKX(NAME,EXT))GO TO 2
39900	C  JUMP BACK IF FILE NAME ALREADY ON DSK
40000		IF(IDEV.NE.1)GO TO 4
40100		CALL TYPWRD(NAME)
40200		CALL TYPCHR('.',1)
40300		CALL TYPCHR(EXT,3)
40400		CALL TYPCRL
40500	4	IF(KX.EQ.0)GO TO 50
40600		IF(NAME.NE.IBLA)GO TO 41
40700		NAME=L
40800		GO TO 101
40900	41	 CALL PUTEXT(NAME,EXT)
41000	42	 IF(INP2.EQ.LDD)GO TO 202
41100	C   SB=SAVE BIG;  SD=SAVE DPY ONLY; SM=SB WITH SAME NAME
41200	102	IRSTF=0
41300		IF(INP2.EQ.LBB)IRSTF=-1
41400		JJ2=ITEM+2
41500		IPOS=I
41600	C WD CNTS
41700		CALL EXTOUT(RSTFAC,128)
41800	C  INCLUDES STFF AND V ARRAYS
41900	C***	CALL EXTOUT(PWDS,JJ2)
42000		CALL EXTOUT(RN,IPOS)
42100		IF(LCNT.GT.1)CALL EXTOUT(LIST,LCNT)
42200	CC102   WRITE(21)ITEM,I
42300	CC	 1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
42400	CC	 1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,SV
42500	C (SV) FOR FORTRAN READ BUG!!!!
42600	CC	 IF(SAVER.GE.0)WRITE(21)RSTFAC,STFF,L
42700	C NOT USED WHEN SAVE IS AUTOMATIC.
42800	C  TAKE OUT ABOVE WHEN BUG IS SOMEDAY FIXED IN F4.
42900		IF(I.LE.LIMIT)GO TO 20
43000		CALL TYPSTR('****** TOO MUCH DATA TO PRINT - ')
43100		CALL TYPINT(I)
43200		CALL TYPCHR('/',1)
43300		CALL TYPINT(LIMIT)
43400	20	 IF(INP2.EQ.LBB)CALL EXTOUT(ST,4302)
43500	1001	CALL FINEXT
43600		IF(INP(1).NE.LSS)RETURN
43700		IF(NAME.NE.IBLA)RETURN
43800		CALL TYPSTR('DISPLAY SAVED IN "TMP.MS"')
43900		CALL TYPCRL
44000	C   GO BACK IF THE SAVER WROTE THE FILE
44100		RETURN
44200	202	WRITE(21),ST2,(ST(L),L=1,ST2+2)
44300		GO TO 1001
44400	C   WRITES DPY BUFFER ONLY.
44500		END
44600	 
44700		SUBROUTINE LISTP(LST)
44800		IMPLICIT INTEGER(A-Q,S-Z)
44900		DIMENSION LST(1)
45000		COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND/ALF/I1,I2,I3
45100		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(16),K,JY,X,Y /XRN/RN(1)
45200		1 /STF/RSTFAC(0/7),RSTJ2 /LIMIT/LIMIT,ITEM,L,I,IX /PTR/PWDS(1)
45300		1 /DL/X22,SAVER,NAME,EXT
45400		EQUIVALENCE (JC,JQ(1)),(JD,JQ(2)),(RJC,RJQ(1)),(RJD,RJQ(2))
45500		1 ,(RJE,RJQ(3))
45600	 
45700		IF(I3.EQ.'X')CALL OFILE(22,NAME)
45800		JY=5
45900		IF(RJE.NE.0)JY=3
46000	CC	 JD=RJD
46100	C  NO LPT FOR NOW	CC IF(JD.NE.0)JY=3
46200	CC	 DO 6334 L=IFIX(R2),JC
46300		JD=RJD
46400		IF(RJC.NE.0)GO TO 1
46500		RJC=1.
46600		JD=ITEM
46700	1	DO 6334 L=IFIX(RJC),JD
46800		X=PWDS(L)
46900		Y=RN(X)+2+X
47000	C1/81   X=X+1
47100	C1/81   K=RN(X)
47200		JK=RN(X+1)
47300		JL=RN(X+2)
47400		X=X+3
47500		IF(I3.NE.'X')GO TO 2
47600	C TYPE 'PRX' TO CREATE 'READ' FILE WITH ALL PARAMS.
47700		IF(JK.NE.16)WRITE(22,3)JK,JL,(RN(K),K=X,Y)
47800		IF(JK.EQ.16)WRITE(22,33)JK,JL,(RN(K),K=X,Y)
47900	C1/81   WRITE(22,3)(RN(K),K=X,Y)
48000		GO TO 6334
48100	3	FORMAT(2I2,F8.2,F9.2,7F7.2)
48200	33	 FORMAT(I2,I3,3F8.2,3F10.0,F7.2,F5.2)
48300	C1/81  3	FORMAT(F4.0,F3.0,3F9.3,4F13.3,3F9.3)
48400	C* NOTICE -- WRITES LINES WHICH ARE TOO LONG! - THEY MUST BE EDITED.
48500	2	WRITE(JY,6333)L,LST(JK),JK,JL,(RN(K),K=X,Y)
48600	C1/81  2	WRITE(JY,6333),L,LST(K),(RN(K),K=X,Y)
48700	6334	CONTINUE
48800	C  P, N1, N2, N3  TYPES ITEM LIST. N1=1ST, N2=LAST, N3=TO LPT?
48900	C  LEAVE THIS HERE SO WRITE(JY, OF R IS POSSIBLE IN DDT
49000	6333	FORMAT(I4,') ',A5,2I3,F8.3,F8.2,7F10.2)
49100	C1/81   6333	FORMAT(I4,') ',A5,2F4.0,F8.3,F8.2,7F10.2)
49200		IF(I3.NE.'X')RETURN
49300		END FILE 22
49400	C WRITES 'FOR22.DAT'
49500	C1/81   CALL TYPSTR('PARAMS WRITTEN ON FOR22.DAT')
49600		CALL TYPSTR('PARAMS WRITTEN ON ')
49700		CALL TYPCHR(NAME,5)
49800		CALL TYPSTR('.DAT')
49900		CALL TYPCRL
50000		END